home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / examples / pixelmap < prev    next >
Encoding:
Text File  |  2001-08-05  |  3.9 KB  |  137 lines
  1. #!/usr/bin/perl
  2.  
  3. use Gimp::Feature 'pdl';
  4. use Gimp 1.099;
  5. use Gimp::Fu;
  6. use Gimp::Util;
  7. use PDL;
  8.  
  9. use constant PI => 4 * atan2 1,1;
  10.  
  11. sub pixelmap {                    # es folgt das eigentliche Skript...
  12.    my($image,$drawable,$_expr)=@_;
  13.  
  14.    Gimp->progress_init ("Mapping pixels...");
  15.    
  16.    my $init="";
  17.  
  18.    $_expr =~ /\$p/   and $init.='$p = $src->data;';
  19.    $_expr =~ /\$P/   and $init.= $drawable->has_alpha ? '$P = $src->data;' : '$P = $src->data->slice("0:-1");';
  20.    $_expr =~ /\$x/   and $init.='$x = (zeroes(long,$w)->xvals + $_dst->x)->dummy(1,$h)->sever;';
  21.    $_expr =~ /\$y/   and $init.='$y = (zeroes(long,$h)->xvals + $_dst->y)->dummy(0,$w)->sever;';
  22.    $_expr =~ /\$bpp/ and $init.='$bpp = $_dst->bpp;';
  23.  
  24.    my($p,$P,$x,$y,$bpp,$w,$h);
  25.  
  26.    $_expr = "sub{$init\n#line 1\n$_expr\n;}";
  27.  
  28.    my @_bounds = $drawable->bounds;
  29.    {
  30.       # $src and $dst must either be scoped or explicitly undef'ed
  31.       # before merge_shadow.
  32.       my $src  = new PixelRgn $drawable->get,@_bounds,0,0;
  33.       my $_dst = new PixelRgn $drawable,@_bounds,1,1;
  34.  
  35.       $_expr = eval $_expr; die "$@" if $@;
  36.  
  37.       $_iter = Gimp->pixel_rgns_register ($src, $_dst);
  38.       my $_area = 0;
  39.  
  40.       do {
  41.          ($w,$h)=($src->w,$src->h);
  42.          $_area += $w*$h/($_bounds[2]*$_bounds[3]);
  43.          $_dst->data(&$_expr);
  44.          Gimp->progress_update ($_area);
  45.       } while (Gimp->pixel_rgns_process ($_iter));
  46.    }
  47.  
  48.    $drawable->merge_shadow (1);
  49.    $drawable->update (@_bounds);
  50.  
  51.    ();        # wir haben kein neues Bild erzeugt
  52. }
  53.  
  54. register "pixelmap",
  55.          "Maps Pixel values and coordinates through general Perl expressions",
  56.          "=pod(DESCRIPTION)",
  57.          "Marc Lehmann",
  58.          "Marc Lehmann <pcg\@goof.com>",
  59.          "19991115",
  60.          N_"<Image>/Filters/Map/Pixelmap...",
  61.          "*",    
  62.          [
  63.            [PF_TEXT,        "expression"    , "The perl expression to use",    "(\$x*\$y*0.01)\n->slice(\"*\$bpp\")"]
  64.          ],
  65.          \&pixelmap;
  66.  
  67. register "pixelgen",
  68.          "Generate the pixels of an image by expressions (in PDL)",
  69.          "=pod(DESCRIPTION)",
  70.          "Marc Lehmann",
  71.          "Marc Lehmann <pcg\@goof.com>",
  72.          "19991115",
  73.          N_"<Toolbox>/Xtns/Render/Pixelgenerator...",
  74.          undef,
  75.          [
  76.            [PF_SPINNER,        "width"        , "The width of the new image to generate",    512, [1, 4096, 1]],
  77.            [PF_SPINNER,        "height"    , "The height of the new image to generate",    512, [1, 4096, 1]],
  78.            [PF_RADIO,        "type"        , "The type of the layer to create (same as gimp_layer_new.type)",
  79.                        RGB_IMAGE    , [RGB => RGB_IMAGE, RGBA => RGBA_IMAGE, GRAY => GRAY_IMAGE,
  80.                                            GRAYA => GRAYA_IMAGE, INDEXED => INDEXED_IMAGE, INDEXEDA => INDEXEDA_IMAGE]],
  81.            [PF_TEXT,        "expression"    , "The perl expression to use",    "(\$x*\$y*0.01)\n->slice(\"*\$bpp\")"]
  82.          ],
  83.          [PF_IMAGE],
  84.          sub {
  85.    my($w,$h,$type,$expr)=@_;
  86.    my $image = new Image $w, $h, Gimp->layer2imagetype($type);
  87.    my $layer = new Layer $image, $w, $h, $type, $expr, 100, NORMAL_MODE;
  88.    $image->add_layer($layer, 0);
  89.    eval { pixelmap($image, $layer, $expr) };
  90.    if ($@) {
  91.       my $error = $@;
  92.       $image->delete;
  93.       die $error;
  94.    };
  95.    $image;
  96. };
  97.  
  98. exit main;
  99.  
  100. =head1 DESCRIPTION
  101.  
  102. Not yet written yet, sorry...
  103.  
  104. =over 4
  105.  
  106. =item $p
  107.  
  108. The source pixels (1..4 bytes per pixel, depending on format). Use like this:
  109.  
  110.  $p*3.5        # the return value is the result
  111.  
  112. =item $P
  113.  
  114. The source pixels without alpha. Use it like this:
  115.  
  116.  $P *= 0.5; $p    # modify $P inplace, return also modified $p as result
  117.  
  118. =item $x
  119.  
  120. A two-dimensional vector containing the x-coordinates of each point in the current tile:
  121.  
  122.  $x = (zeroes(long,$w)->xvals + $destination->x)->dummy(1,$h)->sever;
  123.  
  124. =item $y
  125.  
  126. A two-dimensional vector containing the y-coordinates of each point in the current tile:
  127.  
  128.  $y = (zeroes(long,$h)->xvals + $destination->y)->dummy(0,$w)->sever;
  129.  
  130. =item $bpp
  131.  
  132. The bytes per pixel value of the destination area.
  133.  
  134. =back
  135.  
  136. =cut
  137.